The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/ratpac.src

Text File | 1991-05-29 | 3KB | 143 lines

%%HP: T(3)F(.);
@ RATPAC, by Ted A Smith
DIR
  QAdd  @ Quotient Add
    \<< Q\->3 4 ROLL Q\->3 4 ROLL DUP2 GCD ROT OVER / SWAP ROT OVER / SWAP
     \-> i2 n2 i1 n1 d1 d2 dgcd
      \<< i1 i2 + d1 n2 * d2 n1 * + d1 d2 * dgcd * Q3\->
      \>>
    \>>
  QSub  @ Quotient Subtract
    \<< QNeg QAdd
    \>>
  QMul  @ Quotient Multiply
    \<<
      IF OVER DUP TYPE 9 SAME
        SWAP SIZE 5 SAME AND
        VER DUP TYPE 9 SAME
        SWAP SIZE 5 SAME AND OR
      THEN Q\->3 4 ROLL Q\->3 \-> i2 n2 d2 i1 n1 d1
        \<< i1 i2 * n1 n2 * i2 n1 * d2 * + i1 n2 * d1 * + d1 d2 * Q3\->
        \>>
      ELSE Q\->2 ROT Q\->2 4 ROLL RLT ROT 4 ROLL RLT SWAP ROT * ROT ROT * Q2\->
      END
    \>>
  QDiv  @ Quotient Divide
    \<< QInv QMul
    \>>
  QNeg  @ Quotient Negate
    \<< Q\->3 ROT NEG ROT NEG ROT Q3\->
    \>>
  QInv  @ Quotient Reciprocate
    \<< Q\->2 SWAP Q2\->
    \>>
  Q\->I @ Quotient to Integer
    \<< EVAL IP
    \>>
  Q\->F @ Quotient to Continued Fraction
    \<< { } SWAP Q\->2
      WHILE DUP
      REPEAT DUP2 / IP DUP2 * 5 ROLL ROT + ROT ROT 4 ROLL SWAP -
      END DROP2
    \>>
  QF\-> @ Continued Fraction to Quotient
    \<< OBJ\-> 1 0 1 4 ROLL
      START OVER 4 ROLL * + SWAP
      NEXT Q2\->
    \>>
  CST { QAdd QSub QMul QDiv QNeg QInv Q\->I Q\->F QF\-> }
  Cmp\->  @ convert with ASC->
"D9D20ECE8112040379C1F3040379C194040379C1B7040379C1B21303471"
  GCD  @ Greatest Common Divisor
    \<<
      IF DUP2 AND
      THEN
        WHILE OVER
        REPEAT OVER MOD SWAP
        END SWAP DROP
      ELSE DROP2 1
      END
    \>>
  Q2\->
    \<< Q2\->2
      IF DUP 1 SAME
      THEN DROP
      ELSE { / } OBJ\-> DROP 3 \->Alg
      END
    \>>
  Q2\->2
    \<<
      IF OVER NOT
      THEN DROP 1
      END RLT
      IF DUP 0 <
      THEN NEG SWAP NEG SWAP
      END
    \>>
  Q3\->
    \<< Q2\->2 DUP2 / IP DUP 5 ROLL + SWAP 3 PICK * 4 ROLL SWAP -
      IF OVER SIGN OVER SIGN + NOT
      THEN
        CASE OVER SIGN DUP 1 SAME
          THEN DROP 3 PICK + SWAP 1 - SWAP
          END -1 SAME
          THEN 3 PICK - SWAP 1 + SWAP
          END
        END
      END ROT
      IF OVER
      THEN
        IF 3 PICK
        THEN { / + } OBJ\-> DROP 5
        ELSE ROT DROP { / } OBJ\-> DROP 3
        END \->Alg
      ELSE DROP2
      END
    \>>
  QR\->2
    \<< \->NUM
      CASE DUP FP SIGN DUP NOT
        THEN DROP 1
        END 1 SAME
        THEN \->Q OBJ\-> DROP2
        END NEG \->Q OBJ\-> DROP2 SWAP NEG SWAP
      END
    \>>
  Q\->
    \<<
      IF DUP TYPE 9 SAME
      THEN Cmp\->
        IF DUP 5 SAME
        THEN 3 DROPN 3
        ELSE DROP2 2
        END
      ELSE \->NUM 0
      END
    \>>
  Q\->2 @ Quotient to (improper) fraction, levels 2,1
    \<< Q\->
      IF DUP
      THEN
        IF 3 SAME
        THEN ROT OVER * ROT + SWAP
        END
      ELSE DROP QR\->2
      END
    \>>
  Q\->3 @ Quotient to (proper) fraction, levels 3,2,1
    \<< Q\->
      IF DUP
      THEN
        IF 2 SAME
        THEN 0 ROT ROT
        END
      ELSE SWAP QR\->2
      END
    \>>
  RLT @ Reduce to Lowest Terms
    \<< DUP2 GCD ROT OVER / ROT ROT /
    \>>
  \->Alg  @ convert with ASC->
"D9D2043C81D6450B2130474F"
END